home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_r41.lha / st80_r41 / RDoItR41 / Voss-rdoitR41.st < prev   
Text File  |  1993-07-23  |  7KB  |  239 lines
  1. 'From Objectworks\Smalltalk(R), Release 4.1 of 15 April 1992 on 22 August 1992 at 11:53:11 am'!
  2.  
  3. Model subclass: #RDoItServer
  4.     instanceVariableNames: 'socket myPortNumber '
  5.     classVariableNames: 'BadHosts OkHosts '
  6.     poolDictionaries: ''
  7.     category: 'Voss-RDoIt'!
  8. RDoItServer comment:
  9. 'First how to use:
  10.     [RDoItServer initialize.]    To reset the authorized/unauthorized host sets.
  11.     [RDoItServer start.]    or    
  12.         [RDoItServer startAt: 8004.]    To start a server on port (default 8004).
  13.     [RDoItServer killAll.]        To kill all servers.
  14. ----------------------------------------------------------
  15. This is a quick hack to allow an external C program to execute a Smalltalk doIt.
  16.  
  17.      I built this so I could put the Launcher options on my X11 root menu.
  18.      I also wanted a tiny project to help me get back up to speed after
  19.     not writing any Smalltalk code for a long time.
  20.  
  21. The basic idea is that we start up a Smalltalk process which creates a socket,
  22. and sits there listening for connections.  When a connection comes in, it forks
  23. a subprocess to do the actual work.  This subprocess reads from the socket
  24. until it sees a CR, and then evaluates what it has read (simillar to DoIt in a workspace).
  25. The subprocess then closes its connection and dies, while the main process
  26. continues to wait for connections.   
  27.  
  28. The server also catches the #returnFromSnapshot update: message, and restarts itself.
  29. (That is why it is a subclass of Model instead of Object.)
  30.  
  31. The external C program "rdoit hostname portnumber message" is similar to "rsh" in operation.
  32.  
  33. CAUTION: The doits are NOT logged in the change log.
  34. DANGER: Security is done on a host by host basis.  When a connection
  35.                comes in from a previously unrecognized host, a dialog box
  36.                pops up asking the user to authorize the host.
  37.                 Select yes, and all future requests from that host will suceed.
  38.                 Select no, and all future attempts will be denied.
  39.                 (This is done with the Sets BadHosts and OkHosts.)
  40.            This means that while the server is running, ANY user on any
  41.            authorized host could have your st80 process do anything.
  42.               Including run any program on the system SO BE CAREFUL!!
  43.  
  44. FUTURE WORK:  
  45.     Fix security problems.
  46.                 (There are only two people with accounts on my system,
  47.                  so I personally am not going to "fix" this problem anytime soon.)
  48.  
  49. VERSION LOG:
  50.     June 14th, 1991  -- The Original Version, written for R4.0
  51.     August 22nd, 1992 -- This Version created for R4.1
  52.                 Made RDoItServer a subclass of Model, and fixed the "release" method.
  53.                 Changed from being a dependent of Smalltalk to being a dependent of ObjectMemory.
  54.  
  55. Bill Voss     <voss@cs.uiuc.edu>     August 22nd, 1992
  56.  
  57.  
  58.  
  59. '!
  60.  
  61.  
  62. !RDoItServer methodsFor: 'initialize-release'!
  63.  
  64. release
  65.     (socket isKindOf: UnixSocketAccessor)
  66.         ifTrue: [socket close].
  67.     socket removeDependent: self.
  68.     ObjectMemory removeDependent: self.
  69.     super release.
  70.     socket := nil! !
  71.  
  72. !RDoItServer methodsFor: 'restart-update'!
  73.  
  74. restart
  75.     "Called when snapshot is started, and at instance creation."
  76.  
  77.     [self loopForever]
  78.         forkAt: self serverPriority.
  79.     Transcript cr; show: 'RDoItServer restarted with --'.
  80.     self showHosts: Transcript.
  81.     ^self!
  82.  
  83. startServer
  84.     "This is only run by SERVER instances at startup."
  85.  
  86.     ObjectMemory addDependent: self.
  87.     self restart.
  88.     ^self!
  89.  
  90. startServerAt: aPortNumber 
  91.     "This is only run by SERVER instances at startup."
  92.  
  93.     myPortNumber := aPortNumber.
  94.     ^self startServer!
  95.  
  96. update: aSymbol 
  97.     "Dependents of SystemDictionary Smalltalk are sent update: 
  98.     #returnFromSnapshot when a snapshot is started."
  99.  
  100.     aSymbol == #returnFromSnapshot ifTrue: [self restart].
  101.     super update: aSymbol.
  102.     ^self! !
  103.  
  104. !RDoItServer methodsFor: 'host management'!
  105.  
  106. confirmNewHost: who 
  107.     "A previously unauthorized host is trying to connect."
  108.     "Ask the user if we can authorize this new host."
  109.  
  110.     | answer |
  111.     answer := DialogView confirm: 'RDOIT ok from host ' , who hostName printString , '?' initialAnswer: true.
  112.     answer
  113.         ifTrue: [OkHosts add: who hostName]
  114.         ifFalse: [BadHosts add: who hostName].
  115.     ^answer!
  116.  
  117. showHosts: aTextCollector 
  118.     "Output the current hosts, normally to Transcript."
  119.  
  120.     aTextCollector crtab; show: 'Authorized Hosts '.
  121.     aTextCollector print: OkHosts.
  122.     aTextCollector crtab; show: 'Unauthorized Hosts '.
  123.     aTextCollector print: BadHosts.
  124.     aTextCollector cr; show: ''! !
  125.  
  126. !RDoItServer methodsFor: 'handle client'!
  127.  
  128. handleClient: aSocket 
  129.     "This method is forked off when a new connection arrives."
  130.  
  131.     | who deniedBlock |
  132.     who := aSocket getPeer.
  133.     deniedBlock := [Transcript cr; show: 'Denied rdoit attempt from: ' , who printString].
  134.     (BadHosts includes: who hostName)
  135.         ifTrue: deniedBlock
  136.         ifFalse: [(OkHosts includes: who hostName)
  137.                 ifTrue: [self handleOkClient: aSocket]
  138.                 ifFalse: [(self confirmNewHost: who)
  139.                         ifTrue: [self handleOkClient: aSocket]
  140.                         ifFalse: deniedBlock]].
  141.     aSocket close.
  142.     ^nil!
  143.  
  144. handleOkClient: aSocket 
  145.     "We read through cr, and then doit."
  146.     "Note: evaluate:logged: requires textOrString if logged = true."
  147.  
  148.     | exConn nStrm aCollection |
  149.     exConn := ExternalConnection ioAccessor: aSocket.
  150.     nStrm := exConn readAppendStream.
  151.     aCollection := nStrm through: Character cr.
  152.     ^Compiler
  153.         evaluate: aCollection readStream
  154.         for: self
  155.         logged: false!
  156.  
  157. loopForever
  158.     "Called when snapshot is started, and at instance creation."
  159.     "I create and listen to my socket."
  160.     "Note: Someone else has already forked me, so I can block."
  161.     "SEE ALSO: UnixSocketAccessor class howToImplementAServer."
  162.  
  163.     | newskt thisSocket |
  164.     thisSocket := UnixSocketAccessor newTCPserverAtPort: self portNumber.
  165.     thisSocket notNil
  166.         ifTrue: [socket := thisSocket]
  167.         ifFalse: [^nil].
  168.     thisSocket listenFor: 5.
  169.     newskt := true.
  170.     [socket == thisSocket and: [newskt notNil]]
  171.         whileTrue: 
  172.             [newskt := socket accept.
  173.             newskt notNil ifTrue: [[self handleClient: newskt]
  174.                     forkAt: self handlePriority]].
  175.     thisSocket notNil ifTrue: [thisSocket close].
  176.     self release.
  177.     ^nil! !
  178.  
  179. !RDoItServer methodsFor: 'constants'!
  180.  
  181. handlePriority
  182.     "The priority a handler process should run at."
  183.  
  184.     ^Processor lowIOPriority!
  185.  
  186. serverPriority
  187.     "The priority the server process should run at."
  188.  
  189.     ^Processor lowIOPriority! !
  190.  
  191. !RDoItServer methodsFor: 'private'!
  192.  
  193. portNumber
  194.     "Return my port number."
  195.     "Default st80 R4 == 8004 (totally arbitrary)."
  196.  
  197.     myPortNumber isNil
  198.         ifTrue: [^8004]
  199.         ifFalse: [^myPortNumber]! !
  200. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  201.  
  202. RDoItServer class
  203.     instanceVariableNames: ''!
  204.  
  205.  
  206. !RDoItServer class methodsFor: 'class initialization'!
  207.  
  208. initialize
  209.     "Initialize class variables."
  210.     "RDoItServer initialize."
  211.  
  212.     BadHosts := Set new.
  213.     OkHosts := Set new! !
  214.  
  215. !RDoItServer class methodsFor: 'instance creation'!
  216.  
  217. start
  218.     "Start an rdoit server on the default port."
  219.     "RDoItServer start."
  220.  
  221.     ^self new startServer!
  222.  
  223. startAt: aPortNumber 
  224.     "Start an rdoit server on a specified port."
  225.     "RDoItServer startAt: 8004."
  226.  
  227.     ^self new startServerAt: aPortNumber! !
  228.  
  229. !RDoItServer class methodsFor: 'server destruction'!
  230.  
  231. killAll
  232.     "Destroy all instances of the server."
  233.     "RDoItServer killAll."
  234.  
  235.     RDoItServer allInstances do: [:a | a release].
  236.     ^nil! !
  237.  
  238. RDoItServer initialize!
  239.